home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d4 / gw_slt13.arc / SOURCE.ARC / ANSI.PAS next >
Pascal/Delphi Source File  |  1990-04-01  |  9KB  |  335 lines
  1. UNIT Ansi;
  2.  
  3. INTERFACE
  4.  
  5. USES Crt;
  6.  
  7. PROCEDURE Display_ANSI(ch:char);
  8. { Displays ch following ANSI graphics protocol }
  9.  
  10. {---------------------------------------------------------------------------}
  11. { Useful information for porting this thing over to other computers:
  12.  
  13.   Change background text color        Change foreground text color
  14.   TextBackground(0) = black           TextColor(0) = black
  15.   TextBackground(1) = blue            TextColor(1) = blue
  16.   TextBackground(2) = green           TextColor(2) = green
  17.   TextBackground(3) = cyan            TextColor(3) = cyan
  18.   TextBackground(4) = red             TextColor(4) = red
  19.   TextBackground(5) = Magenta         TextColor(5) = magenta
  20.   TextBackground(6) = brown           TextColor(6) = brown
  21.   TextBackground(7) = light grey      TextColor(7) = white
  22.                                       TextColor(8) = grey
  23.   Delete(s,i,c);                      TextColor(9) = bright blue
  24.     Delete c characters from          TextColor(10)= bright green
  25.     string s starting at i            TextColor(11)= bright cyan
  26.   Val(s,v,c);                         TextColor(12)= bright red
  27.     convert string s to numeric       TextColor(13)= bright magenta
  28.     value v. code=0 if ok.            TextColor(14)= bright yellow
  29.   Length(s)                           TextColor(15)= bright white
  30.     length of string s
  31. }
  32.  
  33. IMPLEMENTATION
  34.  
  35. VAR
  36.   ANSI_St   :String ;  {stores ANSI escape sequence if receiving ANSI}
  37.   ANSI_SCPL :INTEGER;  {stores the saved cursor position line}
  38.   ANSI_SCPC :INTEGER;  {   "    "    "      "       "    column}
  39.   ANSI_FG   :INTEGER;  {stores current foreground}
  40.   ANSI_BG   :INTEGER;  {stores current background}
  41.   ANSI_C,ANSI_I,ANSI_B,ANSI_R:BOOLEAN ;  {stores current attribute options}
  42.  
  43. p,x,y : INTEGER;
  44.  
  45.  
  46. PROCEDURE Display_ANSI(ch:char);
  47. { Displays ch following ANSI graphics protocal }
  48.  
  49.   PROCEDURE TABULATE;
  50.   VAR x:INTEGER;
  51.   BEGIN
  52.     x:=WHEREX;
  53.     IF x<80 THEN
  54.       REPEAT
  55.         Inc(x);
  56.       UNTIL (x MOD 8)=0;
  57.     IF x=80 THEN x:=1;
  58.     GOTOXY(x,WHEREY);
  59.     IF x=1 THEN WRITELN;
  60.   END;
  61.  
  62.   PROCEDURE BACKSPACE;
  63.   VAR x:INTEGER;
  64.   BEGIN
  65.     IF WHEREX>1 THEN
  66.       WRITE(^H,' ',^H)
  67.     ELSE
  68.       IF WHEREY>1 THEN BEGIN
  69.         GOTOXY(80,WHEREY-1);
  70.         WRITE(' ');
  71.         GOTOXY(80,WHEREY-1);
  72.       END;
  73.   END;
  74.  
  75.   PROCEDURE TTY(ch:char);
  76.   VAR x:INTEGER;
  77.   BEGIN
  78.     IF ANSI_C THEN BEGIN
  79.       IF ANSI_I THEN ANSI_FG:=ANSI_FG OR 8;
  80.       IF ANSI_B THEN ANSI_FG:=ANSI_FG OR 16;
  81.       IF ANSI_R THEN BEGIN
  82.         x:=ANSI_FG;
  83.         ANSI_FG:=ANSI_BG;
  84.         ANSI_BG:=x;
  85.       END;
  86.       ANSI_C:=FALSE;
  87.     END;
  88.     TextColor(ANSI_FG);
  89.     TextBackground(ANSI_BG);
  90.     CASE Ch of
  91.       ^G: BEGIN
  92.             Sound(2000);
  93.             Delay(75);
  94.             NoSound;
  95.           END;
  96.       ^H: Backspace;
  97.       ^I: Tabulate;
  98.       ^J: BEGIN
  99.             TextBackground(0);
  100.             Write(^J);
  101.           END;
  102.       ^K: GotoXY(1,1);
  103.       ^L: BEGIN
  104.             TextBackground(0);
  105.             ClrScr;
  106.           END;
  107.       ^M: BEGIN
  108.             TextBackground(0);
  109.             Write(^M);
  110.           END;
  111.       ELSE Write(Ch);
  112.     END;
  113.   END;
  114.  
  115.   PROCEDURE ANSIWrite(S:String);
  116.   VAR x:INTEGER;
  117.   BEGIN
  118.     FOR x:=1 to Length(S) do
  119.       TTY(S[x]);
  120.   END;
  121.  
  122.   FUNCTION Param:INTEGER;   {returns -1 if no more parameters}
  123.   VAR S:String;
  124.       x,XX:INTEGER;
  125.       B:BOOLEAN;
  126.   BEGIN
  127.     B:=FALSE;
  128.     FOR x:=3 TO Length(ANSI_St) DO
  129.       IF ANSI_St[x] in ['0'..'9'] THEN B:=TRUE;
  130.     IF NOT B THEN
  131.       Param:=-1
  132.     ELSE BEGIN
  133.       S:='';
  134.       x:=3;
  135.       IF ANSI_St[3]=';' THEN BEGIN
  136.         Param:=0;
  137.         Delete(ANSI_St,3,1);
  138.         EXIT;
  139.       END;
  140.       REPEAT
  141.         S:=S+ANSI_St[x];
  142.         x:=x+1;
  143.       UNTIL (NOT (ANSI_St[x] IN ['0'..'9'])) or (Length(S)>2) or (x>Length(ANSI_St));
  144.       IF Length(S)>2 THEN BEGIN
  145.         ANSIWrite(ANSI_St+Ch);
  146.         ANSI_St:='';
  147.         Param:=-1;
  148.         EXIT;
  149.       END;
  150.       Delete(ANSI_St,3,Length(S));
  151.       IF ANSI_St[3]=';' THEN Delete(ANSI_St,3,1);
  152.       Val(S,x,XX);
  153.       Param:=x;
  154.     END;
  155.   END;
  156.  
  157. BEGIN
  158.   IF (Ch<>#27) and (ANSI_St='') THEN BEGIN
  159.     TTY(Ch);
  160.     Exit;
  161.   END;
  162.   IF Ch=#27 THEN BEGIN
  163.     IF ANSI_St<>'' THEN BEGIN
  164.       ANSIWrite(ANSI_St+#27);
  165.       ANSI_St:='';
  166.     END ELSE ANSI_St:=#27;
  167.     EXIT;
  168.   END;
  169.   IF ANSI_St=#27 THEN BEGIN
  170.     IF Ch='[' THEN
  171.       ANSI_St:=#27+'['
  172.     ELSE BEGIN
  173.       ANSIWrite(ANSI_St+Ch);
  174.       ANSI_St:='';
  175.     END;
  176.     Exit;
  177.   END;
  178.   IF (Ch='[') and (ANSI_St<>'') THEN BEGIN
  179.     ANSIWrite(ANSI_St+'[');
  180.     ANSI_St:='';
  181.     EXIT;
  182.   END;
  183.   IF not (Ch in ['0'..'9',';','A'..'D','f','H','J','K','m','s','u']) THEN BEGIN
  184.     ANSIWrite(ANSI_St+Ch);
  185.     ANSI_St:='';
  186.     EXIT;
  187.   END;
  188.   IF Ch in ['A'..'D','f','H','J','K','m','s','u'] THEN BEGIN
  189.     CASE Ch of
  190.     'A': BEGIN
  191.            p:=Param;
  192.            IF p=-1 THEN p:=1;
  193.            IF WhereY-p<1 THEN
  194.              GotoXY(Wherex,1)
  195.            ELSE GotoXY(WhereX,WhereY-p);
  196.          END;
  197.     'B': BEGIN
  198.            p:=Param;
  199.            IF p=-1 THEN p:=1;
  200.            IF WhereY+p>25 THEN
  201.              GotoXY(WhereX,25)
  202.            ELSE GotoXY(WhereX,WhereY+p);
  203.          END;
  204.     'C': BEGIN
  205.            p:=Param;
  206.            IF p=-1 THEN p:=1;
  207.            IF WhereX+p>80 THEN
  208.              GotoXY(80,WhereY)
  209.            ELSE GotoXY(WhereX+p,WhereY);
  210.          END;
  211.     'D': BEGIN
  212.            p:=Param;
  213.            IF p=-1 THEN p:=1;
  214.            IF WhereX-p<1 THEN
  215.              GotoXY(1,WhereY)
  216.            ELSE GotoXY(WhereX-p,WhereY);
  217.          END;
  218. 'H','f': BEGIN
  219.            Y:=Param;
  220.            x:=Param;
  221.            IF Y<1 THEN Y:=1;
  222.            IF x<1 THEN x:=1;
  223.            IF (x>80) or (x<1) or (Y>25) or (Y<1) THEN BEGIN
  224.              ANSI_St:='';
  225.              EXIT;
  226.            END;
  227.            GotoXY(x,Y);
  228.          END;
  229.     'J': BEGIN
  230.            p:=Param;
  231.            IF p=2 THEN BEGIN
  232.              TextBackground(0);
  233.              ClrScr;
  234.            END;
  235.            IF p=0 THEN BEGIN
  236.              x:=WhereX;
  237.              Y:=WhereY;
  238.              Window(1,y,80,25);
  239.              TextBackground(0);
  240.              ClrScr;
  241.              Window(1,1,80,25);
  242.              GotoXY(x,Y);
  243.            END;
  244.            IF p=1 THEN BEGIN
  245.              x:=WhereX;
  246.              Y:=WhereY;
  247.              Window(1,1,80,wherey);
  248.              TextBackground(0);
  249.              ClrScr;
  250.              Window(1,1,80,25);
  251.              GotoXY(x,Y);
  252.            END;
  253.          END;
  254.     'K': BEGIN
  255.            TextBackground(0);
  256.            ClrEol;
  257.          END;
  258.     'm': BEGIN
  259.            IF ANSI_St=#27+'[' THEN BEGIN
  260.              ANSI_FG:=7;
  261.              ANSI_BG:=0;
  262.              ANSI_I:=FALSE;
  263.              ANSI_B:=FALSE;
  264.              ANSI_R:=FALSE;
  265.            END;
  266.            REPEAT
  267.              p:=Param;
  268.              CASE p of
  269.                -1:;
  270.                 0:BEGIN
  271.                     ANSI_FG:=7;
  272.                     ANSI_BG:=0;
  273.                     ANSI_I:=FALSE;
  274.                     ANSI_R:=FALSE;
  275.                     ANSI_B:=FALSE;
  276.                   END;
  277.                 1:ANSI_I:=true;
  278.                 5:ANSI_B:=true;
  279.                 7:ANSI_R:=true;
  280.                30:ANSI_FG:=0;
  281.                31:ANSI_FG:=4;
  282.                32:ANSI_FG:=2;
  283.                33:ANSI_FG:=6;
  284.                34:ANSI_FG:=1;
  285.                35:ANSI_FG:=5;
  286.                36:ANSI_FG:=3;
  287.                37:ANSI_FG:=7;
  288.                40:ANSI_BG:=0;
  289.                41:ANSI_BG:=4;
  290.                42:ANSI_BG:=2;
  291.                43:ANSI_BG:=6;
  292.                44:ANSI_BG:=1;
  293.                45:ANSI_BG:=5;
  294.                46:ANSI_BG:=3;
  295.                47:ANSI_BG:=7;
  296.              END;
  297.              IF ((p>=30) and (p<=47)) or (p=1) or (p=5) or (p=7) THEN ANSI_C:=true;
  298.            UNTIL p=-1;
  299.          END;
  300.     's': BEGIN
  301.            ANSI_SCPL:=WhereY;
  302.            ANSI_SCPC:=WhereX;
  303.          END;
  304.     'u': BEGIN
  305.            IF ANSI_SCPL>-1 THEN GotoXY(ANSI_SCPC,ANSI_SCPL);
  306.            ANSI_SCPL:=-1;
  307.            ANSI_SCPC:=-1;
  308.          END;
  309.     END;
  310.     ANSI_St:='';
  311.     EXIT;
  312.   END;
  313.   IF Ch in ['0'..'9',';'] THEN
  314.     ANSI_St:=ANSI_St+Ch;
  315.   IF Length(ANSI_St)>50 THEN BEGIN
  316.     ANSIWrite(ANSI_St);
  317.     ANSI_St:='';
  318.     EXIT;
  319.   END;
  320. END;
  321.  
  322.  
  323. BEGIN
  324.   ANSI_St:='';
  325.   ANSI_SCPL:=-1;
  326.   ANSI_SCPC:=-1;
  327.   ANSI_FG:=7;
  328.   ANSI_BG:=0;
  329.   ANSI_C:=FALSE;
  330.   ANSI_I:=FALSE;
  331.   ANSI_B:=FALSE;
  332.   ANSI_R:=FALSE;
  333. END.
  334.  
  335.